Implemente las estructuras de datos y algoritmos básicos para la solución de un problema mediante algoritmos genéticos. Pruebe estas rutinas para buscar el mínimo global de las siguientes funciones:
\[-x \sin(\sqrt{|x|})\] \[x+\sin(3x)+8\cos(5x)\] \[(x^2+y^2)^{0.25}*[\sin^2(50*(x^2+y^2)^{0.1})+1]\]
¿Corresponde al mínimo global el valor encontrado? Repita la búsqueda varias veces y determine el valor medio y desvío.
¿Se encuentra ahora el mínimo global dentro del intervalo?
repeticionesAlgoritmo <- 10
# Definición de funciones a minimizar
funcion01 <- function(x){
return(-x*sin(sqrt(abs(x))))
}
# Rango de la variable
xMin <- -512
xMax <- 512
resultado <- numeric(0)
for(i in 1:repeticionesAlgoritmo) {
resultadoAlgoritmo <- algoritmoGenetico(cantidadIndividuos = 10, limiteInf = xMin, limiteSup = xMax, generacionesSinCambio = 40, fitnessFn = function(x) {-funcion01(x)})
resultado <- c(resultado, resultadoAlgoritmo$mejor_individuo)
}
## mejor individuo proceso: 420.851895641171
## mejor individuo proceso: 421.053490313573
## mejor individuo proceso: 420.995852123419
## mejor individuo proceso: 421.012309405997
## mejor individuo proceso: 421.665296800169
## mejor individuo proceso: 420.720481629598
## mejor individuo proceso: 419.992524893028
## mejor individuo proceso: 420.982981459779
## mejor individuo proceso: 420.872217919797
## mejor individuo proceso: 420.905076742172
x <- seq(-512, 512, length.out = 255)
y <- funcion01(x)
datos <- as.data.frame(cbind(x,y))
ggplot(data = datos, aes(x = x, y = y)) +
geom_line() +
labs(title = "funcion01") +
theme_bw() +
theme(legend.position = "none") +
geom_vline(xintercept = mean(resultado), color="red")
Se puede apreciar en la gráfica que el mínimo encontrado coincide con el mínimo global dentro del rango. El valor medio de los resultados de la funcion01 es 420.9052127, el desvio estándar es 0.4077722
funcion02 <- function(x){
return(x+sin(3*x)+8*cos(5*x))
}
xMin <- 0
xMax <- 20
resultado <- numeric(0)
for(i in 1:repeticionesAlgoritmo) {
resultadoAlgoritmo <- algoritmoGenetico(cantidadIndividuos = 10, limiteInf = xMin, limiteSup = xMax, generacionesSinCambio = 40, fitnessFn = function(x) {-funcion02(x)})
resultado <- c(resultado, resultadoAlgoritmo$mejor_individuo)
}
## mejor individuo proceso: 1.89630589447916
## mejor individuo proceso: 1.86597908761309
## mejor individuo proceso: 1.86329814461607
## mejor individuo proceso: 1.87046127605498
## mejor individuo proceso: 1.87396869828947
## mejor individuo proceso: 1.8673480128949
## mejor individuo proceso: 1.85096858686744
## mejor individuo proceso: 1.86885090820703
## mejor individuo proceso: 1.87488564341762
## mejor individuo proceso: 1.87026793950038
x <- seq(xMin, xMax, length.out = 255)
y <- funcion02(x)
datos <- as.data.frame(cbind(x,y))
ggplot(data = datos, aes(x = x, y = y)) +
geom_line() +
labs(title = "funcion02") +
theme_bw() +
theme(legend.position = "none") +
geom_vline(xintercept = mean(resultado), color="red")
Se puede apreciar en la gráfica que el mínimo encontrado coincide con el mínimo global dentro del rango. El valor medio de los resultados de la funcion02 es 1.8702334, el desvio estándar es 0.0113675
funcion03 <- function(x, y){
return((x^2+y^2)^0.25*(sin(50*(x^2+y^2)^0.1)^2+1))
}
xMin <- -100
xMax <- 100
resultado <- data.frame(x=numeric(), y=numeric())
for(i in 1:repeticionesAlgoritmo) {
resultadoAlgoritmo <- algoritmoGenetico(cantidadIndividuos = 10, cantidadVariables=2, limiteInf = c(xMin, xMin), limiteSup = c(xMax, xMax), generacionesSinCambio = 40, fitnessFn = function(x,y) {-funcion03(x,y)})
resultado[i, ] <- resultadoAlgoritmo$mejor_individuo
}
## mejor individuo proceso: -0.0224364692891559, -0.0224364692891559
## mejor individuo proceso: -0.0223302280276481, -0.0223302280276481
## mejor individuo proceso: 0.00548248946909857, 0.00548248946909857
## mejor individuo proceso: -0.00373146376138629, -0.00373146376138629
## mejor individuo proceso: 0.00916479343513998, 0.00916479343513998
## mejor individuo proceso: 0.00999976673888489, 0.00999976673888489
## mejor individuo proceso: -0.0107269736525715, -0.0107269736525715
## mejor individuo proceso: -0.00587231479585171, -0.00587231479585171
## mejor individuo proceso: 0.0230066012591124, 0.0230066012591124
## mejor individuo proceso: -0.122193909923006, -0.122193909923006
x <- y <- seq(xMin, xMax, length.out = 255)
z <- outer(x, y, funcion03)
nbcol = 100
color = rev(rainbow(nbcol, start = 0/6, end = 4/6))
zcol = cut(z, nbcol)
p <- plot_ly(x = x, y = y, z = z) %>% add_surface(
contours = list(
z = list(
show=TRUE,
usecolormap=TRUE,
highlightcolor="#ff0000",
project=list(z=TRUE)
)
)
) %>%
layout(
scene = list(
camera=list(
eye = list(x=1.87, y=0.88, z=-0.64)
)
)
)
p
resultado %>% colMeans()
## x y
## -0.01396377 -0.01396377
Se puede apreciar en la gráfica que el mínimo encontrado coincide con el mínimo global dentro del ranggo (tanto para x como para y). El valor medio de los resultados de la funcion03 es -0.0139638, -0.0139638, el desvio estándar es 0.0406753, 0.0406753
En el archivo desconocido1.csv se ha registrado información de un proceso que puede describirse mediante la ecuación: \[y1 = a_1x^3_1 + a_2 x^2_1 + a_3 x_1 + a_4\] Se sabe que las mediciones contienen ruido, y que los parámetro del sistema se encuentran acotados en el intervalo [−5,1.5]. Utilice un algoritmo genético para determinar los parámetros delmodelo. Calcule el error cuadrático total obtenido de la comparción entre los datos provistos y la función aproximada mediante el algoritmo. ¿Qué puede concluir del ajuste?
desconocido1 <- read_csv("../../PUBLICO/Encuentro 5/Práctica/desconocido1.csv", col_names = FALSE)
errorEj2 <- function(a1, a2, a3, a4){
x <- desconocido1[, 1] %>% as.matrix(ncol=1) %>% t()
y <- matrix(rep(desconocido1[, 2], length(a1)) %>% unlist(), ncol=length(x))
# habrá 128 salidas por individuo (una por cada dato del dataset)
# hay tantos individuos como se configure en el algoritmo (100 en este caso)
salidaEstimada <- a1 %*% x^3 + a2 %*% x^2 + a3 %*% x + a4
# la matriz de error es de 100x128
error <- y-salidaEstimada
# los renglones representan a los individuos evaluados
error_cuadratico_medio = rowMeans(error^2)
return(error_cuadratico_medio)
}
# Rango de los parametros
xMin <- -5
xMax <- 1.5
resultado <- algoritmoGenetico(limiteInf = rep(xMin,4), limiteSup = rep(xMax,4), cantidadVariables = 4, fitnessFn = function(a1, a2, a3, a4) {-errorEj2(a1, a2, a3, a4)})
## mejor individuo proceso: 0.825795012176968, -2.17188160202932, 0.024649670929648, -2.3678070231108
Calculamos el error del resultado:
errorEj2(resultado$mejor_individuo[1],resultado$mejor_individuo[2],
resultado$mejor_individuo[3],resultado$mejor_individuo[4])
## [1] 6.857038
Este error que obtenemos está afectado por el ruido que contenían los datos del archivo. Por esto concluimos que es un valor de error es aceptable.